home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / examples.lha / Examples / Roland / Sierpinski.mod < prev   
Text File  |  1995-03-07  |  3KB  |  148 lines
  1. (************************** Sierpinski curves *****************************
  2.  
  3.     MODUL
  4.       Sierpinski.mod
  5.  
  6.     DESCRIPTION
  7.       Sierpinskicurves from "Algorithmen und Datenstrukturen" (N. Wirth)
  8.  
  9.     NOTES
  10.       OS 2.0+
  11.  
  12.     BUGS
  13.  
  14.     TODO
  15.  
  16.     EXAMPLES
  17.  
  18.     SEE ALSO
  19.  
  20.     INDEX
  21.  
  22.     HISTORY
  23.       23-feb-95   Roland Jesse   created
  24.  
  25. ***************************************************************************)
  26.  
  27. <* STANDARD- *>             (* necessary for assignable cleanup procedure *)
  28.  
  29. MODULE Sierpinski;
  30.  
  31. IMPORT
  32.    Dos, Kernel, gfx := Graphics, I := Intuition, SYS := SYSTEM, U := Utility;
  33.  
  34. CONST
  35.    n = 5; h0 = 256;
  36.    Version = "$VER: Sierpinski 1.2 (23.2.95)";
  37.  
  38. VAR
  39.    i, h, x, y, x0, y0 : INTEGER;
  40.    ch : LONGINT;
  41.    screen : I.ScreenPtr;
  42.  
  43. PROCEDURE ^ A(i: INTEGER);
  44. PROCEDURE ^ B(i: INTEGER);
  45. PROCEDURE ^ C(i: INTEGER);
  46. PROCEDURE ^ D(i: INTEGER);
  47.  
  48.  
  49. (* EasyRequest at end of program *)
  50. PROCEDURE Done;
  51. VAR
  52.    es : I.EasyStruct;
  53.    pushed : LONGINT;
  54. BEGIN
  55.    es.structSize := SIZE (I.EasyStruct);
  56.    es.flags := {};
  57.    es.title := SYS.ADR ("Sierpinski");
  58.    es.textFormat := SYS.ADR ("The brushing is over!");
  59.    es.gadgetFormat := SYS.ADR ("Okidoki");
  60.  
  61.    pushed := I.EasyRequest ( NIL, SYS.ADR (es), NIL, NIL );
  62. END Done;
  63.  
  64.  
  65. PROCEDURE Init;
  66. BEGIN
  67.    screen := NIL;
  68.    ASSERT (I.base.libNode.version >= 37, Dos.fail);
  69.    screen := I.OpenScreenTagsA ( NIL,
  70.       I.saTitle, SYS.ADR ("Sierpinskicurves by =rj= in 1995"),
  71.       U.end );
  72.    ASSERT (screen # NIL, Dos.fail);
  73. END Init;
  74.  
  75. PROCEDURE* Cleanup(VAR rc : LONGINT);
  76. BEGIN
  77.    IF screen # NIL THEN
  78.       I.OldCloseScreen (screen);
  79.    END;
  80.    Kernel.RemoveTrapHandler
  81. END Cleanup;
  82.  
  83. PROCEDURE PosPinsel;
  84. BEGIN
  85.    gfx.Move (SYS.ADR (screen.rastPort), x, y)
  86. END PosPinsel;
  87.  
  88. PROCEDURE Pinsel;
  89. BEGIN
  90.    gfx.Draw (SYS.ADR (screen.rastPort), x, y)
  91. END Pinsel;
  92.  
  93. PROCEDURE A(i: INTEGER);
  94. BEGIN
  95.    IF i > 0 THEN
  96.       A(i-1); x := x+h; y := y-h; Pinsel;
  97.       B(i-1); x := x + 2 * h;     Pinsel;
  98.       D(i-1); x := x+h; y := y+h; Pinsel;
  99.       A(i-1);
  100.    END
  101. END A;
  102.  
  103. PROCEDURE B(i: INTEGER);
  104. BEGIN
  105.    IF i > 0 THEN
  106.       B(i-1); x := x-h; y := y-h; Pinsel;
  107.       C(i-1); y := y - 2 * h;     Pinsel;
  108.       A(i-1); x := x+h; y := y-h; Pinsel;
  109.       B(i-1)
  110.    END
  111. END B;
  112.  
  113. PROCEDURE C(i: INTEGER);
  114. BEGIN
  115.    IF i > 0 THEN
  116.       C(i-1); x := x-h; y := y+h; Pinsel;
  117.       D(i-1); x := x - 2 * h;     Pinsel;
  118.       B(i-1); x := x-h; y := y-h; Pinsel;
  119.       C(i-1);
  120.    END
  121. END C;
  122.  
  123. PROCEDURE D(i: INTEGER);
  124. BEGIN
  125.    IF i > 0 THEN
  126.       D(i-1); x := x+h; y := y+h; Pinsel;
  127.       A(i-1); y := y + 2 * h;     Pinsel;
  128.       C(i-1); x := x-h; y := y+h; Pinsel;
  129.       D(i-1);
  130.    END
  131. END D;
  132.  
  133. BEGIN (* main *)
  134.    Kernel.InstallTrapHandler;
  135.    Kernel.SetCleanup (Cleanup);
  136.    Init;
  137.    i := 0; h := h0 DIV 4; x0 := 2*h; y0 := 3*h + 11;
  138.    REPEAT
  139.       i := i+1; x0 := x0-h; h := h DIV 2; y0 := y0+h; x := x0; y := y0;
  140.       PosPinsel;
  141.       A(i); x := x+h; y := y-h; Pinsel;
  142.       B(i); x := x-h; y := y-h; Pinsel;
  143.       C(i); x := x-h; y := y+h; Pinsel;
  144.       D(i); x := x+h; y := y+h; Pinsel;
  145.    UNTIL i = n;
  146.    Done;
  147. END Sierpinski.
  148.